cop network

Here’s a moderately crappy network of GTTF cops (based on rosters) and the cops they have cases with. Could merit a real graph analysis if we want.

library(tidyverse)
library(tidygraph)
library(ggraph)
library(showtext)
library(networkD3)

showtext_auto()

clean_names <- read_csv(here::here("data/cleaned_cop_names.csv"))
tfs <- read_csv(here::here("data/task_force_memberships_dated.csv")) %>%
  rename(officer_id = id)
cases <- readRDS("~/dscr_cops_fetch.rds") %>%
  filter(str_detect(officer_id, "^[A-Z]")) %>%
  select(-name)

# would be cool to build in rank
gttf <- tfs %>%
  mutate(rank = as.factor(rank) %>% fct_relevel("Sgt")) %>%
  filter(str_detect(group, "(Gun Trace|GTTF)"))

edges <- gttf %>%
  distinct(officer_id) %>%
  inner_join(cases, by = "officer_id") %>%
  inner_join(cases, by = "case_number") %>%
  filter(officer_id.x != officer_id.y) %>%
  mutate(id = pmap(list(officer_id.x, officer_id.y), ~sort(c(.x, .y)))) %>%
  unnest_wider(id, names_sep = "") %>%
  group_by(from = id1, to = id2) %>%
  summarise(n_cases = n()) %>%
  ungroup() %>%
  mutate(edge_rank = percent_rank(n_cases))

gttf_net <- edges %>%
  as_tbl_graph(directed = FALSE) %>%
  rename(id = name) %>%
  mutate(degree = centrality_degree(weights = n_cases, loops = FALSE),
         is_gttf = id %in% gttf$officer_id)

gttf_main_net <- gttf_net %>%
  activate(edges) %>%
  filter(n_cases >= 20) %>%
  activate(nodes) %>%
  filter(!node_is_isolated())


gttf_main_net %>%
  ggraph() +
  geom_edge_link(alpha = 0.1) +
  geom_node_point(aes(size = degree, color = is_gttf), alpha = 0.8) +
  theme_void() +
  scale_color_manual(values = c("TRUE" = "mediumorchid", "FALSE" = "gray50")) +
  scale_size_area(max_size = 8)

gttf_net %>%
  mutate(group = as.factor(group_fast_greedy(weights = n_cases))) %>%
  activate(edges) %>%
  filter(n_cases >= 20) %>%
  activate(nodes) %>%
  filter(!node_is_isolated()) %>%
  ggraph() +
  geom_edge_link(alpha = 0.1) +
  geom_node_point(aes(size = degree, color = group), alpha = 0.8) +
  # geom_node_text(aes(label = id), data = . %>% filter(is_gttf)) +
  theme_void() +
  rcartocolor::scale_color_carto_d(palette = "Vivid") +
  scale_size_area(max_size = 8)

This is a totally cheap diagram—I might build something bigger & more useful as a React app

edge_to_d3 <- gttf_main_net %>%
  activate(edges) %>%
  as_tibble() %>%
  mutate(across(c(from, to), ~ . - 1)) %>%
  as.data.frame()
node_to_d3 <- gttf_main_net %>%
  as_tibble() %>%
  mutate(is_gttf = ifelse(is_gttf, "GTTF member", "Non-GTTF")) %>%
  left_join(clean_names, by = c("id" = "officer_id")) %>%
  group_by(id) %>%
  top_n(1, n) %>%
  as.data.frame()

forceNetwork(Links = edge_to_d3, Nodes = node_to_d3, Source = "from", Target = "to", 
             Value = "n_cases", NodeID = "name_clean", Group = "is_gttf", Nodesize = "degree",
             opacity = 0.8, colourScale = JS("d3.scaleOrdinal(['#6b7694', '#c1338b']);"), 
             height = 800, width = 800, charge = -10,
             radiusCalculation = JS("Math.sqrt(d.nodesize) / 3"), 
             linkWidth = JS("function(d) { return Math.sqrt(d.value) / 2; }"),
             linkColour = "#ababab", bounded = TRUE, fontSize = 14)